home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / perl5.005.tar.gz / perl5.005.tar / perl5.005 / bytecode.pl < prev    next >
Perl Script  |  1998-07-21  |  11KB  |  389 lines
  1. use strict;
  2. my %alias_to = (
  3.     U32 => [qw(PADOFFSET STRLEN)],
  4.     I32 => [qw(SSize_t long)],
  5.     U16 => [qw(OPCODE line_t short)],
  6.     U8 => [qw(char)],
  7. );
  8.  
  9. my @optype= qw(OP UNOP BINOP LOGOP CONDOP LISTOP PMOP SVOP GVOP PVOP LOOP COP);
  10.  
  11. # Nullsv *must* come first in the following so that the condition
  12. # ($$sv == 0) can continue to be used to test (sv == Nullsv).
  13. my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
  14.  
  15. my (%alias_from, $from, $tos);
  16. while (($from, $tos) = each %alias_to) {
  17.     map { $alias_from{$_} = $from } @$tos;
  18. }
  19.  
  20. my $c_header = <<'EOT';
  21. /*
  22.  *      Copyright (c) 1996-1998 Malcolm Beattie
  23.  *
  24.  *      You may distribute under the terms of either the GNU General Public
  25.  *      License or the Artistic License, as specified in the README file.
  26.  *
  27.  */
  28. /*
  29.  * This file is autogenerated from bytecode.pl. Changes made here will be lost.
  30.  */
  31. EOT
  32.  
  33. my $perl_header;
  34. ($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g;
  35.  
  36. unlink "byterun.c", "byterun.h", "ext/B/B/Asmdata.pm";
  37.  
  38. #
  39. # Start with boilerplate for Asmdata.pm
  40. #
  41. open(ASMDATA_PM, ">ext/B/B/Asmdata.pm") or die "ext/B/B/Asmdata.pm: $!";
  42. print ASMDATA_PM $perl_header, <<'EOT';
  43. package B::Asmdata;
  44. use Exporter;
  45. @ISA = qw(Exporter);
  46. @EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
  47. use vars qw(%insn_data @insn_name @optype @specialsv_name);
  48.  
  49. EOT
  50. print ASMDATA_PM <<"EOT";
  51. \@optype = qw(@optype);
  52. \@specialsv_name = qw(@specialsv);
  53.  
  54. # XXX insn_data is initialised this way because with a large
  55. # %insn_data = (foo => [...], bar => [...], ...) initialiser
  56. # I get a hard-to-track-down stack underflow and segfault.
  57. EOT
  58.  
  59. #
  60. # Boilerplate for byterun.c
  61. #
  62. open(BYTERUN_C, ">byterun.c") or die "byterun.c: $!";
  63. print BYTERUN_C $c_header, <<'EOT';
  64.  
  65. #include "EXTERN.h"
  66. #include "perl.h"
  67.  
  68. void *
  69. bset_obj_store(void *obj, I32 ix)
  70. {
  71.     if (ix > PL_bytecode_obj_list_fill) {
  72.     if (PL_bytecode_obj_list_fill == -1)
  73.         New(666, PL_bytecode_obj_list, ix + 1, void*);
  74.     else
  75.         Renew(PL_bytecode_obj_list, ix + 1, void*);
  76.     PL_bytecode_obj_list_fill = ix;
  77.     }
  78.     PL_bytecode_obj_list[ix] = obj;
  79.     return obj;
  80. }
  81.  
  82. #ifdef INDIRECT_BGET_MACROS
  83. void byterun(struct bytestream bs)
  84. #else
  85. void byterun(PerlIO *fp)
  86. #endif /* INDIRECT_BGET_MACROS */
  87. {
  88.     dTHR;
  89.     int insn;
  90.     while ((insn = BGET_FGETC()) != EOF) {
  91.     switch (insn) {
  92. EOT
  93.  
  94.  
  95. my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
  96.  
  97. while (<DATA>) {
  98.     chop;
  99.     s/#.*//;            # remove comments
  100.     next unless length;
  101.     if (/^%number\s+(.*)/) {
  102.     $insn_num = $1;
  103.     next;
  104.     } elsif (/%enum\s+(.*?)\s+(.*)/) {
  105.     create_enum($1, $2);    # must come before instructions
  106.     next;
  107.     }
  108.     ($insn, $lvalue, $argtype, $flags) = split;
  109.     $insn_name[$insn_num] = $insn;
  110.     $fundtype = $alias_from{$argtype} || $argtype;
  111.  
  112.     #
  113.     # Add the case statement and code for the bytecode interpreter in byterun.c
  114.     #
  115.     printf BYTERUN_C "\t  case INSN_%s:\t\t/* %d */\n\t    {\n",
  116.     uc($insn), $insn_num;
  117.     my $optarg = $argtype eq "none" ? "" : ", arg";
  118.     if ($optarg) {
  119.     printf BYTERUN_C "\t\t$argtype arg;\n\t\tBGET_%s(arg);\n", $fundtype;
  120.     }
  121.     if ($flags =~ /x/) {
  122.     print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
  123.     } elsif ($flags =~ /s/) {
  124.     # Store instructions store to PL_bytecode_obj_list[arg]. "lvalue" field is rvalue.
  125.     print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
  126.     }
  127.     elsif ($optarg && $lvalue ne "none") {
  128.     print BYTERUN_C "\t\t$lvalue = arg;\n";
  129.     }
  130.     print BYTERUN_C "\t\tbreak;\n\t    }\n";
  131.  
  132.     #
  133.     # Add the initialiser line for %insn_data in Asmdata.pm
  134.     #
  135.     print ASMDATA_PM <<"EOT";
  136. \$insn_data{$insn} = [$insn_num, \\&PUT_$fundtype, "GET_$fundtype"];
  137. EOT
  138.  
  139.     # Find the next unused instruction number
  140.     do { $insn_num++ } while $insn_name[$insn_num];
  141. }
  142.  
  143. #
  144. # Finish off byterun.c
  145. #
  146. print BYTERUN_C <<'EOT';
  147.       default:
  148.         croak("Illegal bytecode instruction %d\n", insn);
  149.         /* NOTREACHED */
  150.     }
  151.     }
  152. }
  153. EOT
  154.  
  155. #
  156. # Write the instruction and optype enum constants into byterun.h
  157. #
  158. open(BYTERUN_H, ">byterun.h") or die "byterun.h: $!";
  159. print BYTERUN_H $c_header, <<'EOT';
  160. #ifdef INDIRECT_BGET_MACROS
  161. struct bytestream {
  162.     void *data;
  163.     int (*fgetc)(void *);
  164.     int (*fread)(char *, size_t, size_t, void*);
  165.     void (*freadpv)(U32, void*);
  166. };
  167. #endif /* INDIRECT_BGET_MACROS */
  168.  
  169. void *bset_obj_store _((void *, I32));
  170.  
  171. enum {
  172. EOT
  173.  
  174. my $i = 0;
  175. my $add_enum_value = 0;
  176. my $max_insn;
  177. for ($i = 0; $i < @insn_name; $i++) {
  178.     $insn = uc($insn_name[$i]);
  179.     if (defined($insn)) {
  180.     $max_insn = $i;
  181.     if ($add_enum_value) {
  182.         print BYTERUN_H "    INSN_$insn = $i,\t\t\t/* $i */\n";
  183.         $add_enum_value = 0;
  184.     } else {
  185.         print BYTERUN_H "    INSN_$insn,\t\t\t/* $i */\n";
  186.     }
  187.     } else {
  188.     $add_enum_value = 1;
  189.     }
  190. }
  191.  
  192. print BYTERUN_H "    MAX_INSN = $max_insn\n};\n";
  193.  
  194. print BYTERUN_H "\nenum {\n";
  195. for ($i = 0; $i < @optype - 1; $i++) {
  196.     printf BYTERUN_H "    OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
  197. }
  198. printf BYTERUN_H "    OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
  199. print BYTERUN_H <<'EOT';
  200. EXT int optype_size[]
  201. #ifdef DOINIT
  202. = {
  203. EOT
  204. for ($i = 0; $i < @optype - 1; $i++) {
  205.     printf BYTERUN_H "    sizeof(%s),\n", $optype[$i], $i;
  206. }
  207. printf BYTERUN_H "    sizeof(%s)\n}\n", $optype[$i], $i;
  208. print BYTERUN_H <<'EOT';
  209. #endif /* DOINIT */
  210. ;
  211.  
  212. EOT
  213.  
  214. print BYTERUN_H <<'EOT';
  215. #define INIT_SPECIALSV_LIST STMT_START { \
  216. EOT
  217. for ($i = 0; $i < @specialsv; $i++) {
  218.     print BYTERUN_H "\tPL_specialsv_list[$i] = $specialsv[$i]; \\\n";
  219. }
  220. print BYTERUN_H <<'EOT';
  221.     } STMT_END
  222. EOT
  223.  
  224. #
  225. # Finish off insn_data and create array initialisers in Asmdata.pm
  226. #
  227. print ASMDATA_PM <<'EOT';
  228.  
  229. my ($insn_name, $insn_data);
  230. while (($insn_name, $insn_data) = each %insn_data) {
  231.     $insn_name[$insn_data->[0]] = $insn_name;
  232. }
  233. # Fill in any gaps
  234. @insn_name = map($_ || "unused", @insn_name);
  235.  
  236. 1;
  237.  
  238. __END__
  239.  
  240. =head1 NAME
  241.  
  242. B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
  243.  
  244. =head1 SYNOPSIS
  245.  
  246.     use Asmdata;
  247.  
  248. =head1 DESCRIPTION
  249.  
  250. See F<ext/B/B/Asmdata.pm>.
  251.  
  252. =head1 AUTHOR
  253.  
  254. Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
  255.  
  256. =cut
  257. EOT
  258.  
  259. __END__
  260. # First set instruction ord("#") to read comment to end-of-line (sneaky)
  261. %number 35
  262. comment        arg            comment_t
  263. # Then make ord("\n") into a no-op
  264. %number 10
  265. nop        none            none
  266. # Now for the rest of the ordinary ones, beginning with \0 which is
  267. # ret so that \0-terminated strings can be read properly as bytecode.
  268. %number 0
  269. #
  270. #opcode        lvalue                    argtype        flags    
  271. #
  272. ret        none                    none        x
  273. ldsv        PL_bytecode_sv                svindex
  274. ldop        PL_op                    opindex
  275. stsv        PL_bytecode_sv                U32        s
  276. stop        PL_op                    U32        s
  277. ldspecsv    PL_bytecode_sv                U8        x
  278. newsv        PL_bytecode_sv                U8        x
  279. newop        PL_op                    U8        x
  280. newopn        PL_op                    U8        x
  281. newpv        none                    PV
  282. pv_cur        PL_bytecode_pv.xpv_cur            STRLEN
  283. pv_free        PL_bytecode_pv                none        x
  284. sv_upgrade    PL_bytecode_sv                char        x
  285. sv_refcnt    SvREFCNT(PL_bytecode_sv)        U32
  286. sv_refcnt_add    SvREFCNT(PL_bytecode_sv)        I32        x
  287. sv_flags    SvFLAGS(PL_bytecode_sv)            U32
  288. xrv        SvRV(PL_bytecode_sv)            svindex
  289. xpv        PL_bytecode_sv                none        x
  290. xiv32        SvIVX(PL_bytecode_sv)            I32
  291. xiv64        SvIVX(PL_bytecode_sv)            IV64
  292. xnv        SvNVX(PL_bytecode_sv)            double
  293. xlv_targoff    LvTARGOFF(PL_bytecode_sv)        STRLEN
  294. xlv_targlen    LvTARGLEN(PL_bytecode_sv)        STRLEN
  295. xlv_targ    LvTARG(PL_bytecode_sv)            svindex
  296. xlv_type    LvTYPE(PL_bytecode_sv)            char
  297. xbm_useful    BmUSEFUL(PL_bytecode_sv)        I32
  298. xbm_previous    BmPREVIOUS(PL_bytecode_sv)        U16
  299. xbm_rare    BmRARE(PL_bytecode_sv)            U8
  300. xfm_lines    FmLINES(PL_bytecode_sv)            I32
  301. xio_lines    IoLINES(PL_bytecode_sv)            long
  302. xio_page    IoPAGE(PL_bytecode_sv)            long
  303. xio_page_len    IoPAGE_LEN(PL_bytecode_sv)        long
  304. xio_lines_left    IoLINES_LEFT(PL_bytecode_sv)        long
  305. xio_top_name    IoTOP_NAME(PL_bytecode_sv)        pvcontents
  306. xio_top_gv    *(SV**)&IoTOP_GV(PL_bytecode_sv)    svindex
  307. xio_fmt_name    IoFMT_NAME(PL_bytecode_sv)        pvcontents
  308. xio_fmt_gv    *(SV**)&IoFMT_GV(PL_bytecode_sv)    svindex
  309. xio_bottom_name    IoBOTTOM_NAME(PL_bytecode_sv)        pvcontents
  310. xio_bottom_gv    *(SV**)&IoBOTTOM_GV(PL_bytecode_sv)    svindex
  311. xio_subprocess    IoSUBPROCESS(PL_bytecode_sv)        short
  312. xio_type    IoTYPE(PL_bytecode_sv)            char
  313. xio_flags    IoFLAGS(PL_bytecode_sv)            char
  314. xcv_stash    *(SV**)&CvSTASH(PL_bytecode_sv)        svindex
  315. xcv_start    CvSTART(PL_bytecode_sv)            opindex
  316. xcv_root    CvROOT(PL_bytecode_sv)            opindex
  317. xcv_gv        *(SV**)&CvGV(PL_bytecode_sv)        svindex
  318. xcv_filegv    *(SV**)&CvFILEGV(PL_bytecode_sv)    svindex
  319. xcv_depth    CvDEPTH(PL_bytecode_sv)            long
  320. xcv_padlist    *(SV**)&CvPADLIST(PL_bytecode_sv)    svindex
  321. xcv_outside    *(SV**)&CvOUTSIDE(PL_bytecode_sv)    svindex
  322. xcv_flags    CvFLAGS(PL_bytecode_sv)            U8
  323. av_extend    PL_bytecode_sv                SSize_t        x
  324. av_push        PL_bytecode_sv                svindex        x
  325. xav_fill    AvFILLp(PL_bytecode_sv)            SSize_t
  326. xav_max        AvMAX(PL_bytecode_sv)            SSize_t
  327. xav_flags    AvFLAGS(PL_bytecode_sv)            U8
  328. xhv_riter    HvRITER(PL_bytecode_sv)            I32
  329. xhv_name    HvNAME(PL_bytecode_sv)            pvcontents
  330. hv_store    PL_bytecode_sv                svindex        x
  331. sv_magic    PL_bytecode_sv                char        x
  332. mg_obj        SvMAGIC(PL_bytecode_sv)->mg_obj        svindex
  333. mg_private    SvMAGIC(PL_bytecode_sv)->mg_private    U16
  334. mg_flags    SvMAGIC(PL_bytecode_sv)->mg_flags    U8
  335. mg_pv        SvMAGIC(PL_bytecode_sv)            pvcontents    x
  336. xmg_stash    *(SV**)&SvSTASH(PL_bytecode_sv)        svindex
  337. gv_fetchpv    PL_bytecode_sv                strconst    x
  338. gv_stashpv    PL_bytecode_sv                strconst    x
  339. gp_sv        GvSV(PL_bytecode_sv)            svindex
  340. gp_refcnt    GvREFCNT(PL_bytecode_sv)        U32
  341. gp_refcnt_add    GvREFCNT(PL_bytecode_sv)        I32        x
  342. gp_av        *(SV**)&GvAV(PL_bytecode_sv)        svindex
  343. gp_hv        *(SV**)&GvHV(PL_bytecode_sv)        svindex
  344. gp_cv        *(SV**)&GvCV(PL_bytecode_sv)        svindex
  345. gp_filegv    *(SV**)&GvFILEGV(PL_bytecode_sv)    svindex
  346. gp_io        *(SV**)&GvIOp(PL_bytecode_sv)        svindex
  347. gp_form        *(SV**)&GvFORM(PL_bytecode_sv)        svindex
  348. gp_cvgen    GvCVGEN(PL_bytecode_sv)            U32
  349. gp_line        GvLINE(PL_bytecode_sv)            line_t
  350. gp_share    PL_bytecode_sv                svindex        x
  351. xgv_flags    GvFLAGS(PL_bytecode_sv)            U8
  352. op_next        PL_op->op_next                opindex
  353. op_sibling    PL_op->op_sibling            opindex
  354. op_ppaddr    PL_op->op_ppaddr            strconst    x
  355. op_targ        PL_op->op_targ                PADOFFSET
  356. op_type        PL_op                    OPCODE        x
  357. op_seq        PL_op->op_seq                U16
  358. op_flags    PL_op->op_flags                U8
  359. op_private    PL_op->op_private            U8
  360. op_first    cUNOP->op_first                opindex
  361. op_last        cBINOP->op_last                opindex
  362. op_other    cLOGOP->op_other            opindex
  363. op_true        cCONDOP->op_true            opindex
  364. op_false    cCONDOP->op_false            opindex
  365. op_children    cLISTOP->op_children            U32
  366. op_pmreplroot    cPMOP->op_pmreplroot            opindex
  367. op_pmreplrootgv    *(SV**)&cPMOP->op_pmreplroot        svindex
  368. op_pmreplstart    cPMOP->op_pmreplstart            opindex
  369. op_pmnext    *(OP**)&cPMOP->op_pmnext        opindex
  370. pregcomp    PL_op                    pvcontents    x
  371. op_pmflags    cPMOP->op_pmflags            U16
  372. op_pmpermflags    cPMOP->op_pmpermflags            U16
  373. op_sv        cSVOP->op_sv                svindex
  374. op_gv        *(SV**)&cGVOP->op_gv            svindex
  375. op_pv        cPVOP->op_pv                pvcontents
  376. op_pv_tr    cPVOP->op_pv                op_tr_array
  377. op_redoop    cLOOP->op_redoop            opindex
  378. op_nextop    cLOOP->op_nextop            opindex
  379. op_lastop    cLOOP->op_lastop            opindex
  380. cop_label    cCOP->cop_label                pvcontents
  381. cop_stash    *(SV**)&cCOP->cop_stash            svindex
  382. cop_filegv    *(SV**)&cCOP->cop_filegv        svindex
  383. cop_seq        cCOP->cop_seq                U32
  384. cop_arybase    cCOP->cop_arybase            I32
  385. cop_line    cCOP->cop_line                line_t
  386. main_start    PL_main_start                opindex
  387. main_root    PL_main_root                opindex
  388. curpad        PL_curpad                svindex        x
  389.